home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / room3d / fdrivers.frm < prev    next >
Text File  |  1999-02-23  |  9KB  |  293 lines
  1. VERSION 5.00
  2. Begin VB.Form fDrivers 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   0  'None
  6.    ClientHeight    =   4500
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   6000
  10.    LinkTopic       =   "Form1"
  11.    Moveable        =   0   'False
  12.    Picture         =   "fDrivers.frx":0000
  13.    ScaleHeight     =   300
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   400
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.ListBox lstDrv 
  19.       BackColor       =   &H80000006&
  20.       ForeColor       =   &H0000FF00&
  21.       Height          =   2595
  22.       Left            =   240
  23.       TabIndex        =   5
  24.       Top             =   840
  25.       Width           =   5535
  26.    End
  27.    Begin VB.Label lblCancel 
  28.       BackStyle       =   0  'Transparent
  29.       Height          =   495
  30.       Left            =   240
  31.       TabIndex        =   4
  32.       Top             =   3720
  33.       Width           =   2655
  34.    End
  35.    Begin VB.Label lblAccept 
  36.       BackStyle       =   0  'Transparent
  37.       Height          =   495
  38.       Left            =   3120
  39.       TabIndex        =   3
  40.       Top             =   3720
  41.       Width           =   2655
  42.    End
  43.    Begin VB.Shape shpBorder 
  44.       BorderColor     =   &H00808080&
  45.       Height          =   495
  46.       Index           =   2
  47.       Left            =   3120
  48.       Top             =   3720
  49.       Width           =   2655
  50.    End
  51.    Begin VB.Shape shpBorder 
  52.       BorderColor     =   &H00808080&
  53.       Height          =   495
  54.       Index           =   3
  55.       Left            =   240
  56.       Top             =   3720
  57.       Width           =   2655
  58.    End
  59.    Begin VB.Shape shpBorder 
  60.       BorderColor     =   &H00808080&
  61.       Height          =   495
  62.       Index           =   1
  63.       Left            =   240
  64.       Top             =   240
  65.       Width           =   5535
  66.    End
  67.    Begin VB.Label lblTitle 
  68.       Appearance      =   0  'Flat
  69.       BackColor       =   &H80000005&
  70.       BackStyle       =   0  'Transparent
  71.       Caption         =   "Select Direct3D driver"
  72.       BeginProperty Font 
  73.          Name            =   "Arial"
  74.          Size            =   12
  75.          Charset         =   0
  76.          Weight          =   700
  77.          Underline       =   0   'False
  78.          Italic          =   0   'False
  79.          Strikethrough   =   0   'False
  80.       EndProperty
  81.       ForeColor       =   &H00C0C0C0&
  82.       Height          =   240
  83.       Index           =   10
  84.       Left            =   360
  85.       TabIndex        =   2
  86.       Top             =   360
  87.       Width           =   5280
  88.    End
  89.    Begin VB.Label lblCaptionAccept 
  90.       Alignment       =   2  'Center
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "Accept"
  93.       BeginProperty Font 
  94.          Name            =   "Arial"
  95.          Size            =   12
  96.          Charset         =   0
  97.          Weight          =   700
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       ForeColor       =   &H00C0C0C0&
  103.       Height          =   255
  104.       Left            =   3120
  105.       TabIndex        =   1
  106.       Top             =   3840
  107.       Width           =   2655
  108.    End
  109.    Begin VB.Label lblCaptionCancel 
  110.       Alignment       =   2  'Center
  111.       BackStyle       =   0  'Transparent
  112.       Caption         =   "Cancel"
  113.       BeginProperty Font 
  114.          Name            =   "Arial"
  115.          Size            =   12
  116.          Charset         =   0
  117.          Weight          =   700
  118.          Underline       =   0   'False
  119.          Italic          =   0   'False
  120.          Strikethrough   =   0   'False
  121.       EndProperty
  122.       ForeColor       =   &H00C0C0C0&
  123.       Height          =   255
  124.       Left            =   240
  125.       TabIndex        =   0
  126.       Top             =   3840
  127.       Width           =   2655
  128.    End
  129. End
  130. Attribute VB_Name = "fDrivers"
  131. Attribute VB_GlobalNameSpace = False
  132. Attribute VB_Creatable = False
  133. Attribute VB_PredeclaredId = True
  134. Attribute VB_Exposed = False
  135. Option Explicit
  136.  
  137. ' Color constants for display of selection ...
  138.     Private Const RGBHighLight = 12640480   ' Highlight for mouse hover
  139.     Private Const RGBStandard = 12632256    ' Default gray
  140.     Private Const RGBSelected = 12648447    ' Highlight for selected items
  141.     
  142. ' Enumeration for possible highlights
  143.     Private Enum eHighlights
  144.         eHighlightNone = -1
  145.         eHighlightDriver = 0
  146.         eHighlightAccept = 2
  147.         eHighlightCancel = 1
  148.     End Enum
  149.     
  150. ' DirectX instance variables...
  151.     Private I_oDDInstance As IDirectDraw2                ' Instance of DirectDraw interface
  152.     Private I_oD3DInstance As IDirect3D2                 ' Instance of Direct3DIM interface
  153.  
  154. ' Local copies of form properties...
  155.     Private I_bStatus As Boolean                         ' Contains error status
  156.  
  157. ' STATUS: Tells if driver detection succeeded
  158. Public Property Get Status() As Boolean
  159.     Status = I_bStatus
  160. End Property
  161.  
  162. ' FORMLOAD: Query Direct3D for drivers, set labels
  163. Private Sub Form_Load()
  164.     ' Setup local variables ...
  165.         
  166.         Dim L_nRun As Integer
  167.     
  168.     ' Detect drivers ...
  169.             
  170.         ' Create instance of DirectDraw
  171.         DirectDrawCreate ByVal 0&, I_oDDInstance, Nothing
  172.         
  173.         ' Check instance existance, terminate if missing
  174.         If I_oDDInstance Is Nothing Then
  175.            I_bStatus = False
  176.            Me.Hide
  177.            Exit Sub
  178.         End If
  179.         
  180.         ' Query DirectDraw for D3D interface
  181.         Set I_oD3DInstance = I_oDDInstance
  182.     
  183.         ' Check instance existance, terminate if missing
  184.         If I_oDDInstance Is Nothing Then
  185.            I_bStatus = False
  186.            Me.Hide
  187.            Exit Sub
  188.         End If
  189.  
  190.         ' Set error handler to local for enumeration only
  191.         On Error Resume Next
  192.         
  193.         ' Start the callback that does the driver enumeration
  194.         G_nD3DDriverCount = -1
  195.         I_oD3DInstance.EnumDevices AddressOf EnumDeviceCallback, 0
  196.     
  197.         ' Catch any error resulting from the enumeration and terminate
  198.         If err.Number > 0 Then
  199.            I_bStatus = False
  200.            Me.Hide
  201.            Exit Sub
  202.         End If
  203.     
  204.         ' Reset error handler to default
  205.         On Error GoTo 0
  206.         
  207.         ' Check if any drivers found
  208.         If G_nD3DDriverCount = -1 Then
  209.            I_bStatus = False
  210.            Me.Hide
  211.            Exit Sub
  212.         End If
  213.             
  214.         ' Remember selected driver, initially the first one
  215.         G_dD3DSelectedDriver = G_dD3DDriver(0)
  216.         I_bStatus = True
  217.         
  218.         ' Cleanup DirectX
  219.         Set I_oD3DInstance = Nothing
  220.         Set I_oDDInstance = Nothing
  221.         
  222.     ' Write drivers into labels ...
  223.         
  224.         For L_nRun = 0 To 9
  225.             If L_nRun <= G_nD3DDriverCount Then
  226.                 lstDrv.AddItem G_dD3DDriver(L_nRun).DESC
  227.             End If
  228.         Next
  229.     If lstDrv.ListCount > 0 Then lstDrv.ListIndex = (lstDrv.ListCount - 1)
  230.     If lstDrv.ListCount > 1 Then lstDrv.ListIndex = (lstDrv.ListCount - 2)
  231. End Sub
  232.  
  233. ' LBLACCEPT_CLICK: Accept selected driver and close dialog
  234. Private Sub lblAccept_Click()
  235.     lstDrv.SetFocus
  236.     G_dD3DSelectedDriver = G_dD3DDriver(lstDrv.ListIndex)
  237.  
  238.     ' Show click on label
  239.     Me.lblAccept.ForeColor = RGBSelected
  240.     
  241.     ' Close form
  242.     Me.Hide
  243.     Call AppStart
  244.         
  245. End Sub
  246.  
  247. ' LBLCANCEL_CLICL: Close form and return cancelled
  248. Private Sub lblCancel_Click()
  249.     
  250.     ' Show click on label
  251.     Me.lblCancel.ForeColor = RGBSelected
  252.     
  253.     ' Set cancel status
  254.     I_bStatus = False
  255.     
  256.     ' Close form
  257.     Me.Hide
  258.     End
  259. End Sub
  260. Private Sub lblTitle_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  261.     Call SetHighlights(eHighlightNone)
  262. End Sub
  263. Private Sub lblCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  264.     Call SetHighlights(eHighlightCancel